home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyProgress.p < prev    next >
Encoding:
Text File  |  1996-10-10  |  2.8 KB  |  136 lines  |  [TEXT/CWIE]
  1. unit MyProgress;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     procedure PaintBarberPoll (r: Rect; offset: integer);
  9.     procedure PaintProgress (r: Rect; done, total: longint);
  10.  
  11. implementation
  12.  
  13.     uses
  14.         Memory, FixMath, 
  15.         MyTypes, MyLowLevel, MyUtils, MyMemory;
  16.  
  17.     var
  18.         gPPFilled,gPPEmpy:Rect;
  19.     
  20.     procedure PaintProgress (r: Rect; done, total: longint);
  21.         var
  22.             w, uw: integer;
  23.             dark,light:RGBColor;
  24.     begin
  25.         FrameRect(r);
  26.         InsetRect(r, 1, 1);
  27.         if total<0 then begin
  28.             EraseRect(r);
  29.         end else begin
  30.             w := r.right - r.left;
  31.             if total <= 0 then begin
  32.                 uw := 0;
  33.             end else if done >= total then begin
  34.                 uw := w;
  35.             end else begin
  36.                 uw := FracMul(w, FracDiv(done, total));
  37.             end;
  38.             gPPFilled:=r;
  39.             gPPEmpy:=r;
  40.             gPPFilled.right := r.left + uw;
  41.             gPPEmpy.left :=  r.left + uw;
  42.     
  43.             MakeRGBColor($4000,$4000,$4000,dark);
  44.             MakeRGBColor($CCCC,$CCCC,$FFFF,light);
  45.             RGBForeColor(dark);
  46.             RGBBackColor(light);
  47.             PaintRect(gPPFilled);
  48.             RGBForeColor(light);
  49.             RGBBackColor(dark);
  50.             PaintRect(gPPEmpy);
  51.             ForeColor(blackColor);
  52.             BackColor(whiteColor);
  53.         end;
  54.     end;
  55.  
  56. {$PUSH}
  57. {$ALIGN MAC68K}
  58.  
  59.     type
  60.         MyPicture = record
  61.                 size: integer;
  62.                 r1: Rect;
  63.                 data1: array[1..17] of integer;
  64.                 r2: Rect;
  65.                 nintyeight: integer;
  66.                 rowbytes: integer;
  67.                 r3: Rect;
  68.                 data2: array[1..34] of integer;
  69.                 r4: Rect;
  70.                 r5: Rect;
  71.                 mode: integer;
  72.                 eor: integer;
  73.             end;
  74.         MyPicturePtr = ^MyPicture;
  75.         MyPictureHandle = ^MyPicturePtr;
  76.  
  77. {$ALIGN RESET}
  78. {$POP}
  79.  
  80.     procedure PaintBarberPoll (r: Rect; offset: integer);
  81.         var
  82.             ph: MyPictureHandle;
  83.             rb: integer;
  84.             ts: integer;
  85.             p: ^integer;
  86.             i, j: integer;
  87.             b1, b2: integer;
  88.             o: integer;
  89.             junk: OSErr;
  90.     begin
  91.         FrameRect(r);
  92.         InsetRect(r, 1, 1);
  93.         rb := (2 * (r.right - r.left) + 15) div 16 * 2;
  94.         ts := SizeOf(MyPicture) + (r.bottom - r.top) * (rb + 2);
  95.         junk := MNewHandle( ph, ts );
  96.         HLock(Handle(ph));
  97.         with ph^^ do begin
  98.             size := ts;
  99.             r1 := r;
  100.             r2 := r;
  101.             r3 := r;
  102.             r4 := r;
  103.             r5 := r;
  104.             nintyeight := $0098;
  105.             rowbytes := BOR(rb, $8000);
  106.             mode := 0;
  107.             StuffHex(@data1, '001102FF0C00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0001000A');
  108.             StuffHex(@data2, '0000000000000000004800000048000000000002000100020000000000000000000000000000000000000002000000000000000000014444444444440002CCCCCCCCFFFF');
  109.             p := @eor;
  110.             for i := r.top to r.bottom - 1 do begin
  111.                 p^ := BOR(BSL(rb + 1, 8), rb - 1);
  112.                 OffsetPtr(p, 2);
  113.                 o := BAND((offset + i) * 2, 31);
  114.                 if o < 16 then begin
  115.                     b1 := BSR($5555AAAA, o);
  116.                     b2 := BSR($AAAA5555, o);
  117.                 end else begin
  118.                     b1 := BSR($AAAA5555, o - 16);
  119.                     b2 := BSR($5555AAAA, o - 16);
  120.                 end;
  121.                 for j := 1 to rb div 2 do begin
  122.                     if odd(j) then begin
  123.                         p^ := b1;
  124.                     end else begin
  125.                         p^ := b2;
  126.                     end;
  127.                     OffsetPtr(p, 2);
  128.                 end;
  129.             end;
  130.             p^ := $00FF; {end of record}
  131.         end;
  132.         DrawPicture(PicHandle(ph), r);
  133.         MDisposeHandle( ph );
  134.     end;
  135.  
  136. end.